#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::Exceptions;

use strict;


sub session {
    my $self = shift;
    my $rcode = eval {
	local $SIG{__WARN__} = sub { $self->logmsg(w => "[perl warning] $_[0]") };
	local $SIG{'ALRM'} = sub { die "ABORT: Timed out\n" };
	local $SIG{'TERM'} = sub { die "ABORT: Server shutting down\n" };
	$self->SUPER::session(@_);
    };
    if ($@) {
	my $ex = $@;
	if ($ex =~ /^ABORT: (.+)/) {
	    # Caught an explicit die("ABORT: reason")
	    $self->logmsg(i => "performing server-initiated quit ($1)");
	    $rcode = $self->reply([421, "$1: closing connection"]);
	}
	else {
	    # Oh dear, we seem to have crashed somewhere. Try to be graceful.
	    $self->logmsg(c => "failed: $ex");
	    $self->logmsg(i => "performing server-initiated quit (Crash!)");
	    $self->reply([421, "Internal server error: closing connection"]);
	    die $ex;
	}
    }
    return ($rcode);
}


sub get_line {
    my ($self, $timeout) = @_;
    alarm($timeout)
	if defined($timeout);
    my $line = $self->SUPER::get_line;
    alarm(0)
	if defined($timeout);
    return ($line);
}


1;
